home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / ConvertToBW.pdrx < prev    next >
Text File  |  1992-06-16  |  2KB  |  82 lines
  1. /*
  2. @N
  3.  
  4. This Genie will convert the current selection of objects to Black and White
  5. */
  6. msg = PDSetup.rexx(2,0)
  7. units = getclip(pds_units)
  8. if msg ~= 1 then exit_msg(msg)
  9.  
  10. black = "Black"
  11. white = "White"
  12.  
  13. obj = pdm_SelFirstObj()
  14. if obj = 0 then exit_msg("Please select a group of objects first")
  15.  
  16. threshold = pdm_GetForm("Enter black threshold..", 8, "Threshold %:50")
  17. if threshold = '' then exit_msg()
  18.  
  19. if ~datatype(threshold, n) then exit_msg("Invalid Entry")
  20. if threshold > 100 | theshold < 0 then exit_msg("Invalid Entry")
  21. threshold = 15 * threshold / 100
  22.  
  23. do while obj ~= 0
  24.  
  25.     lcdata    = pdm_GetColorData(pdm_GetLineColor(obj))
  26.     red        = range(1, 15, word(lcdata, 1) * .3) * 1
  27.     green    = range(1, 15, word(lcdata, 2) * .59) * 1
  28.     blue    = range(1, 15, word(lcdata, 3) * .11) * 1
  29.     grey    = red + green + blue
  30.     if grey  >= threshold then  lcdata = white
  31.     else lcdata = black
  32.  
  33.     call pdm_SetLineColor(obj, lcdata)
  34.  
  35.     fill = pdm_GetFillPattern(obj)
  36.     parse var fill type '0a'x color1 '0a'x color2 '0a'x a '0a'x b '0a'x c '0a'x d 
  37.  
  38.     if type ~= 0 then
  39.     do
  40.         color1    = pdm_GetColorData(color1)
  41.         red        = range(1, 15, word(color1, 1) * .3) * 1
  42.         green    = range(1, 15, word(color1, 2) * .59) * 1
  43.         blue    = range(1, 15, word(color1, 3) * .11) * 1
  44.         grey    = red + green + blue
  45.         
  46.         if grey >= threshold then color1 = white
  47.         else color1 = black
  48.  
  49.         if type > 1 then
  50.         do
  51.             color2 = pdm_GetColorData(color2)
  52.             red        = range(1, 15, word(color2, 1) * .3) * 1
  53.             green    = range(1, 15, word(color2, 2) * .59) * 1
  54.             blue    = range(1, 15, word(color2, 3) * .11) * 1
  55.             grey2    = red + green + blue
  56.             
  57.             if grey2 >= threshold then color2 = white
  58.             else color2 = black
  59.             a = 2      /* make grad fills into 2 steps */
  60.             if color1 = color2 then type = 1   /* make it a solid fill */
  61.         end
  62.  
  63.         call pdm_SetFillPattern(obj, type, color1, color2, a, b, c, d)
  64.     end
  65.  
  66.     obj = pdm_SelNextObj(obj)
  67.  
  68. end
  69.  
  70. exit_msg()
  71.  
  72. exit_msg: procedure expose units
  73. do
  74.     parse arg message
  75.  
  76.     if message ~= '' then call pdm_Inform(1,message,)
  77.     call pdm_SetUnits(units)
  78.     call pdm_AutoUpdate(1)
  79.     exit
  80. end
  81.  
  82.